home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Interactive 7
/
PC World Interactive 7.iso
/
program
/
qbprog.EXE
/
HSCBAS.BAS
< prev
next >
Wrap
BASIC Source File
|
1980-01-10
|
1KB
|
54 lines
DECLARE SUB Dinle (BYVAL Segm%, BYVAL Ofset%, BYVAL Bel%)
DECLARE SUB Kapa ()
DECLARE SUB YavasKapa ()
DECLARE SUB Bellek (A%)
DECLARE SUB Bekle ()
TYPE Dosyalar
Ax AS INTEGER
Bx AS INTEGER
Cx AS INTEGER
Dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
Flags AS INTEGER
Ds AS INTEGER
Es AS INTEGER
HscDt AS STRING * 15000
END TYPE
DECLARE SUB Interruptx (Kesme AS INTEGER, Git AS Dosyalar, Gel AS Dosyalar)
DIM SHARED Yap AS Dosyalar
DIM SHARED BellekC%
CLS
A$ = "odam.hsc"
CLOSE #1: OPEN A$ FOR BINARY AS #1
IF LOF(1) = 0 THEN CLOSE #1: KILL A$: PRINT A$; " bulunamadì..": END
CALL Bellek(11913): BellekC% = Yap.Ax
Yap.HscDt = SPACE$(LOF(1))
GET #1, , Yap.HscDt
Dinle VARSEG(Yap.HscDt), VARPTR(Yap.HscDt), BellekC%
PRINT A$; " dinleniyor, Esc)Bitir"
DO: LOOP UNTIL INP(&H60) = 1
YavasKapa
FOR I = 1 TO 5: Bekle: NEXT
Kapa
CLS : END
SUB Bekle
DEF SEG = 0
FOR I = 1 TO 15
A = PEEK(1132): DO: LOOP UNTIL PEEK(1132) <> A
NEXT
END SUB
SUB Bellek (A%)
Bos& = SETMEM(-1 * (A% + 17))
Yap.Ax = &H4800: Yap.Bx = A% \ 16 + 1
CALL Interruptx(&H21, Yap, Yap)
IF (Yap.Flags AND 1) THEN PRINT "Hata": END
END SUB